indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 3.6.3## -- Attaching packages -------------------------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.0
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## Warning: package 'ggplot2' was built under R version 3.6.3## Warning: package 'tibble' was built under R version 3.6.3## Warning: package 'readr' was built under R version 3.6.3## Warning: package 'dplyr' was built under R version 3.6.3## Warning: package 'forcats' was built under R version 3.6.3## -- Conflicts ----------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)## Warning: package 'plotly' was built under R version 3.6.3##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)## Warning: package 'broom' was built under R version 3.6.3Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke, cases_per_100000_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.## Warning: Ignoring 1 observations p2## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "cases_cum_clarke", "new_cases_clarke", "X7_day_ave_clarke", "cases_per_100000_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 210)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 12.74842 12.76093 12.77317 12.78514 12.79686 12.80834 12.81959 12.83064
## [9] 12.84148 12.85213 12.86261 12.87293 12.88311 12.89314 12.90306 12.91281
## [17] 12.92237 12.93172 12.94086 12.94978 12.95847 12.96693 12.97515 12.98312
## [25] 12.99083 12.99829 13.00548 13.01240 13.01904 13.02540 13.03148 13.03729
## [33] 13.04283 13.04810 13.05310 13.05783 13.06231 13.06653 13.07048 13.07419
## [41] 13.07764 13.08083 13.08378 13.08649 13.08895 13.09117 13.09315 13.09489
## [49] 13.09639 13.09767 13.09883 13.09997 13.10105 13.10204 13.10289 13.10357
## [57] 13.10405 13.10429 13.10424 13.10388 13.10316 13.10204 13.10050 13.09849
## [65] 13.09565 13.09173 13.08680 13.08096 13.07430 13.06691 13.05889 13.05032
## [73] 13.04130 13.03192 13.02227 13.01244 13.00252 12.99261 12.98279 12.97316
## [81] 12.96381 12.95483 12.94631 12.93834 12.93102 12.92178 12.90844 12.89164
## [89] 12.87204 12.85029 12.82704 12.80293 12.77861 12.75474 12.73197 12.71094
## [97] 12.69231 12.67673 12.66483 12.65593 12.64878 12.64330 12.63936 12.63685
## [105] 12.63566 12.63569 12.63682 12.63895 12.64195 12.64573 12.65016 12.65514
## [113] 12.66057 12.66632 12.67229 12.67836 12.68444 12.69040 12.69613 12.70153
## [121] 12.70622 12.71003 12.71311 12.71566 12.71784 12.71982 12.72178 12.72388
## [129] 12.72631 12.72924 12.73283 12.73726 12.74271 12.74641 12.74621 12.74322
## [137] 12.73854 12.73328 12.72854 12.72542 12.72503 12.72848 12.73383 12.73867
## [145] 12.74339 12.74837 12.75400 12.76068 12.76877 12.77954 12.79362 12.81049
## [153] 12.82963 12.85051 12.87261 12.89541 12.91838 12.94100 12.96275 12.98311
## [161] 13.00155 13.01960 13.03883 13.05882 13.07913 13.09933 13.11899 13.13769
## [169] 13.15616 13.17533 13.19508 13.21527 13.23574 13.25638 13.27704 13.29757
## [177] 13.31785 13.33773 13.35708 13.37576 13.39362 13.41054 13.42691 13.44323
## [185] 13.45946 13.47559 13.49159 13.50743 13.52309 13.53854 13.55376 13.56873
## [193] 13.58341 13.59779 13.61184 13.62553 13.63889 13.65198 13.66479 13.67733
## [201] 13.68962 13.70166 13.71345 13.72500 13.73632 13.74742 13.75830 13.76897
## [209] 13.77944 13.78971#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 210)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.61857 12.60923 12.59987 12.59056 12.58138 12.57240 12.56371 12.55537
## [9] 12.54747 12.54009 12.53330 12.52717 12.52180 12.51724 12.51359 12.51071
## [17] 12.50840 12.50662 12.50531 12.50445 12.50397 12.50384 12.50400 12.50442
## [25] 12.50504 12.50583 12.50674 12.50771 12.50871 12.51008 12.51216 12.51488
## [33] 12.51820 12.52205 12.52639 12.53114 12.53626 12.54168 12.54736 12.55323
## [41] 12.55923 12.56531 12.57142 12.57749 12.58347 12.58930 12.59492 12.60029
## [49] 12.60533 12.60999 12.61538 12.62244 12.63093 12.64058 12.65113 12.66233
## [57] 12.67391 12.68562 12.69719 12.70838 12.71891 12.72853 12.73699 12.74402
## [65] 12.75178 12.76240 12.77555 12.79092 12.80818 12.82702 12.84712 12.86815
## [73] 12.88980 12.91175 12.93368 12.95526 12.97617 12.99611 13.01474 13.03175
## [81] 13.04681 13.05962 13.06984 13.07716 13.08125 13.07973 13.07108 13.05634
## [89] 13.03653 13.01268 12.98581 12.95696 12.92715 12.89740 12.86875 12.84221
## [97] 12.81883 12.79961 12.78560 12.77265 12.75620 12.73667 12.71447 12.68999
## [105] 12.66366 12.63588 12.60706 12.57761 12.54795 12.51847 12.48959 12.46172
## [113] 12.43527 12.41064 12.38825 12.36851 12.35182 12.33860 12.32925 12.32418
## [121] 12.32359 12.32683 12.33303 12.34130 12.35078 12.36061 12.36989 12.37777
## [129] 12.38732 12.40168 12.42009 12.44178 12.46598 12.49192 12.51882 12.54593
## [137] 12.57247 12.59768 12.62078 12.64101 12.66086 12.68284 12.70618 12.73012
## [145] 12.75390 12.77675 12.79790 12.81889 12.84151 12.86534 12.89001 12.91511
## [153] 12.94026 12.96505 12.98909 13.01199 13.03838 13.07134 13.10817 13.14620
## [161] 13.18271 13.21502 13.24044 13.26151 13.28250 13.30327 13.32370 13.34365
## [169] 13.36298 13.38156 13.39925 13.41593 13.43146 13.44571 13.45853 13.47028
## [177] 13.48138 13.49179 13.50152 13.51052 13.51879 13.52630 13.53302 13.53895
## [185] 13.54405 13.54831 13.55170 13.55421 13.55581 13.55656 13.55653 13.55571
## [193] 13.55412 13.55174 13.54857 13.54463 13.53989 13.53437 13.52806 13.52096
## [201] 13.51308 13.50440 13.49493 13.48467 13.47360 13.46171 13.44900 13.43550
## [209] 13.42121 13.40615#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 210)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.20060 11.24562 11.28983 11.33321 11.37577 11.41748 11.45835 11.49837
## [9] 11.53753 11.57583 11.61326 11.64981 11.68547 11.72025 11.75413 11.78711
## [17] 11.81917 11.85032 11.88055 11.90985 11.93821 11.96563 11.99213 12.01773
## [25] 12.04243 12.06624 12.08916 12.11120 12.13236 12.15263 12.17204 12.19057
## [33] 12.20823 12.22503 12.24097 12.25605 12.26996 12.28241 12.29348 12.30323
## [41] 12.31173 12.31903 12.32521 12.33032 12.33444 12.33762 12.33994 12.34145
## [49] 12.34222 12.34232 12.34181 12.34075 12.33921 12.33726 12.33495 12.33236
## [57] 12.32955 12.32566 12.31994 12.31258 12.30379 12.29376 12.28270 12.27080
## [65] 12.25827 12.24531 12.23211 12.21888 12.20582 12.19312 12.18099 12.16683
## [73] 12.14820 12.12555 12.09932 12.06995 12.03789 12.00358 11.96746 11.92999
## [81] 11.89159 11.85273 11.81384 11.77536 11.73774 11.70142 11.66685 11.63447
## [89] 11.60473 11.57806 11.55492 11.53574 11.51688 11.49483 11.47025 11.44379
## [97] 11.41614 11.38793 11.35984 11.33252 11.30665 11.28287 11.26185 11.24425
## [105] 11.23074 11.22197 11.21765 11.21689 11.21944 11.22505 11.23348 11.24449
## [113] 11.25783 11.27324 11.29049 11.30934 11.32953 11.35082 11.37296 11.39571
## [121] 11.41882 11.44205 11.46515 11.48788 11.50998 11.53122 11.55387 11.57971
## [129] 11.60779 11.63712 11.66674 11.69567 11.72296 11.74969 11.77750 11.80619
## [137] 11.83556 11.86541 11.89554 11.92575 11.95584 11.98561 12.01470 12.04308
## [145] 12.07107 12.09898 12.12712 12.15582 12.18539 12.21724 12.25215 12.28945
## [153] 12.32848 12.36860 12.40914 12.44945 12.48887 12.52675 12.56242 12.59523
## [161] 12.62453 12.65430 12.68775 12.72311 12.75859 12.79240 12.82276 12.84788
## [169] 12.86952 12.89055 12.91089 12.93046 12.94918 12.96695 12.98370 12.99934
## [177] 13.01379 13.02697 13.03879 13.04916 13.05801 13.06525 13.07125 13.07641
## [185] 13.08066 13.08394 13.08620 13.08736 13.08736 13.08614 13.08365 13.07981
## [193] 13.07456 13.06784 13.05959 13.04975 13.03841 13.02570 13.01165 12.99626
## [201] 12.97955 12.96153 12.94220 12.92158 12.89968 12.87652 12.85210 12.82644
## [209] 12.79954 12.77143#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")